home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / cert / trk3_eg / in_out / dbchart.bas < prev    next >
Encoding:
BASIC Source File  |  1993-10-25  |  4.2 KB  |  158 lines
  1. Option Explicit
  2.  
  3. Global Const Frame_Size = 20
  4. Global recordcount As Integer
  5. Global Const FieldCount = 3
  6. Global Const DBName = "DATA.MDB"
  7. Global DBPath As String
  8. Global DBFullPathName As String
  9. Global DataRecPos As String
  10. ' DragOver
  11. Global Const ENTER = 0
  12. Global Const LEAVE = 1
  13. Global Const OVER = 2
  14. 'OLE Client Control
  15. 'Actions
  16. Global Const OLE_CREATE_EMBED = 0
  17. Global Const OLE_CREATE_NEW = 0           'from ole1 control
  18. Global Const OLE_CREATE_LINK = 1
  19. Global Const OLE_CREATE_FROM_FILE = 1     'from ole1 control
  20. Global Const OLE_COPY = 4
  21. Global Const OLE_PASTE = 5
  22. Global Const OLE_UPDATE = 6
  23. Global Const OLE_ACTIVATE = 7
  24. Global Const OLE_CLOSE = 9
  25.  
  26.  
  27. Global Const DataPath = "C:\aaamarch\msu\vbmsu\example\"
  28.  
  29.  
  30.  
  31. Declare Function GetActiveWindow Lib "User" () As Integer
  32.  
  33. Function chartname (topicstr As String) As String
  34. Dim mytemp As String
  35. Dim chpos As Integer
  36. Dim setpos As Integer
  37. Dim chnum As Integer
  38.  
  39.     chpos = 1
  40.     Do
  41.     setpos = chpos
  42.     chpos = InStr(chpos + 1, topicstr, "chart", 1)
  43.     Loop While chpos > 0
  44.  
  45.     chnum = Val(Mid(topicstr, setpos + 5, 2))
  46.     chartname = "Chart" & chnum
  47. End Function
  48.  
  49. Sub LoadFrame ()
  50.     Dim lstudents As String
  51.     Dim ltest1 As Integer
  52.     Dim ltest2 As Integer
  53.     Dim r As Integer, c As Integer, temp As Integer
  54.     Dim rclear As Integer, cclear As Integer
  55.     Dim Breakout As Integer
  56.     Dim C1Width As Integer, C2Width As Integer
  57.     Dim Calc_Height As Integer
  58.    
  59.     
  60.     Const DELTA = 125
  61.  
  62.     On Error Resume Next
  63.  
  64.     form1.Data1.Recordset.MoveFirst
  65.  
  66.     'Establish a size for the grid.
  67.     Form2.Grid1.Width = 5000
  68.     Form2.Grid1.Cols = FieldCount + 1
  69.     Form2.Grid1.Rows = Frame_Size
  70.     Form2.Grid1.ColWidth(0) = 200
  71.     Form2.Grid1.ColWidth(1) = 1500
  72.     Form2.Grid1.ColWidth(2) = 1500
  73.     Form2.Grid1.ColWidth(3) = 1500
  74.  
  75.     'Clear out the current grid contents.
  76.     For rclear = 1 To recordcount
  77.         'Hit all three columns.
  78.         For cclear = 1 To FieldCount
  79.             Form2.Grid1.Col = cclear
  80.             Form2.Grid1.Text = ""
  81.         Next cclear
  82.     Next rclear
  83.  
  84.     'Set Column label eg. A B C D...
  85.     Form2.Grid1.Row = 0
  86.     Dim collbl As Integer
  87.     For collbl = 1 To FieldCount
  88.         Form2.Grid1.Col = collbl
  89.         Form2.Grid1.Text = Chr$(64 + collbl)
  90.     Next collbl
  91.     
  92.     'Set the field names
  93.     Form2.Grid1.Row = 1
  94.     Dim Fcnt As Integer
  95.     For Fcnt = 1 To FieldCount
  96.         Form2.Grid1.Col = Fcnt
  97.         Form2.Grid1.Text = form1.Data1.Recordset.Fields(Fcnt - 1).Name
  98.     Next Fcnt
  99.     
  100.     'Set Row labels 1
  101.     Form2.Grid1.Row = 1
  102.     Form2.Grid1.Col = 0
  103.     Form2.Grid1.Text = 1
  104.     
  105.     For r = 2 To Frame_Size
  106.  
  107.         Form2.Grid1.Row = r
  108.         
  109.         'Set Row label eg. 2  3  4  5...
  110.         Form2.Grid1.Col = 0
  111.         Form2.Grid1.Text = r
  112.         
  113.         'Get employee ID #
  114.         Form2.Grid1.Col = 1
  115.         lstudents = form1.Data1.Recordset!Students
  116.         Form2.Grid1.Text = lstudents
  117.         
  118.         'Get last name
  119.         Form2.Grid1.Col = 2
  120.         ltest1 = form1.Data1.Recordset!Test1
  121.         Form2.Grid1.Text = ltest1
  122.  
  123.         'Get first name
  124.         Form2.Grid1.Col = 3
  125.         ltest2 = form1.Data1.Recordset!Test2
  126.         Form2.Grid1.Text = ltest2
  127.         
  128.         'If it's not the last iteration of this loop, attempt to
  129.         'move to the next record. If an error occurs, the program
  130.         'will leave this loop.
  131.         If r <> Frame_Size Then
  132.             form1.Data1.Recordset.MoveNext
  133.             If form1.Data1.Recordset.EOF Then
  134.                 Exit For
  135.             End If
  136.         End If
  137.         
  138.     Next r
  139.     recordcount = r
  140.     'These constants, arrived at experimentally, size the
  141.     'grid box appropriately.
  142.     Const G_HEIGHT = 60
  143.     Const G_WIDTH = 310
  144.     Form2.Grid1.Rows = recordcount
  145.     Calc_Height = (recordcount) * (Form2.Grid1.RowHeight(1) + G_HEIGHT)
  146.     If Calc_Height > 3000 Then Calc_Height = 3000
  147.     Form2.Grid1.Height = Calc_Height
  148.     
  149. 'Select all data
  150. Form2.Grid1.Row = 1
  151. Form2.Grid1.Col = 1
  152. Form2.Grid1.SelStartCol = 1
  153. Form2.Grid1.SelEndCol = FieldCount
  154. Form2.Grid1.SelStartRow = 1
  155. Form2.Grid1.SelEndRow = recordcount - 1
  156. End Sub
  157.  
  158.